\ Shellsort Ham 12:00 11/01/92 \ This file contains a generic Shellsort (defined in 1959 by \ D. L. Shell). It consists of the same program code as in \ the file SORT.SCR, except that this file is designed to \ be included in a program with the phrase INCLUDE SORTCODE.SCR \ (you must specify the extension when you use INCLUDE.) \ The difference is that the test words have been removed from \ this version. Use HERE before and after loading this file \ to find out how many bytes the code occupies in the data \ dictionary. \ If you INCLUDE a file, you can use screen 0 for source code, \ though screen 0 cannot be used with LOAD. \ Sort vectors Ham 12:00 11/01/92 \ "i" denotes item number--e.g., slot number VARIABLE #ELTS \ the number of elements to be sorted VARIABLE PRIOR? \ address of word to do comparisons \ The stack diagram for the word in PRIOR? is ( i1 i2 - f ) \ The flag is true if contents of item2 ("i2") go BEFORE the \ contents of item1. That is, the word, given the indexes of \ two items, compares the sort fields of i1 and i2 and leaves \ a true flag only if item 1 should be sorted before item 2. VARIABLE EXCHANGE \ address of word to exchange items \ The stack diagram for the word in EXCHANGE is ( i1 i2 - ) \ Shell sort setup Ham 12:00 11/01/92 : INTERVAL ( - gap ) 1 BEGIN 3 * 1+ DUP #ELTS @ 1- U> UNTIL ; ( gap = no. of elts apart for the partition ) : NEX ( gap i1 - nexti ) + ; \ leave no. of next item : BAK ( gap i1 - previousi ) SWAP - ; \ leave no. of prev item : SHUTTLE ( gap i - ) BEGIN 2DUP BAK ( 2 indexes now ) DUP 0< IF TRUE ( quit: have backed up past element no. zero ) ELSE SWAP 2DUP PRIOR? PERFORM ( do we need an exchange? ) IF 2DUP EXCHANGE PERFORM DROP FALSE ( keep going ) ELSE TRUE ( no = quit ) THEN THEN UNTIL 3DROP ; ( shuttle goes back up the partition until it doesn't need ) ( to make an exchange or until it exhausts the array bkwrds ) \ Shell sort Ham 12:00 11/01/92 : DOTHISPART ( gap 1st-i - gap ) BEGIN 2DUP NEX DUP #ELTS @ U< WHILE ( still within array: gap i1 i2 ) 2DUP PRIOR? PERFORM IF 2DUP EXCHANGE PERFORM >R ( save item # i2 ) 2DUP SHUTTLE ( using gap & i1 ) R> THEN NIP ( prev elt no.--the i1 we started with ) REPEAT ( through the partition ) 2DROP ; : DOEACHPART ( gap - gap ) DUP 0 DO I DOTHISPART LOOP ; : SORT INTERVAL BEGIN 3 / ?DUP ( down to next gap size ) WHILE ( gap size > 0 ) DOEACHPART REPEAT ( for next smaller gap size ) ;
